home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fpatches.for < prev    next >
Text File  |  1991-06-07  |  6KB  |  304 lines
  1. c
  2. c    Draws patches of various bases
  3. c
  4.     program fpatch
  5.  
  6. $INCLUDE: 'fvogl.h'
  7. $INCLUDE: 'fvodevic.h'
  8.  
  9. c
  10. c  patch basis types
  11. c
  12.     integer *2 val, vminx, vmaxx, vminy, vmaxy
  13.     real bezier(4,4), cardinal(4, 4), bspline(4, 4)
  14.     real power(4, 4)
  15.     real x1(4, 4), y1(4, 4), z1(4, 4)
  16.     real x2(4, 4), y2(4, 4), z2(4, 4)
  17.  
  18.     character *50 labels(4)
  19.  
  20.     real    basis(64)
  21.     equivalence (basis(1), bezier(1, 1))
  22.     equivalence (basis(17), cardinal(1, 1))
  23.     equivalence (basis(33), bspline(1, 1))
  24.     equivalence (basis(49), power(1, 1))
  25.  
  26.     data bezier/
  27.      +        -1.0,    3.0,    -3.0,    1.0,
  28.      +        3.0,    -6.0,    3.0,    0.0,
  29.      +        -3.0,    3.0,    0.0,    0.0,
  30.      +        1.0,    0.0,    0.0,    0.0/ 
  31.  
  32.     data cardinal/
  33.      +        -0.5,    1.5,    -1.5,    0.5,
  34.      +        1.0,    -2.5,    2.0,    -0.5,
  35.      +        -0.5,    0.0,    0.5,    0.0,
  36.      +        0.0,    1.0,    0.0,    0.0/
  37.  
  38.     data bspline/
  39.      +         -0.166666,     0.5,     -0.5,     0.166666,
  40.      +         0.5,          -1.0,      0.5,     0.0,
  41.      +            -0.5,          0.0,      0.5,     0.0, 
  42.      +         0.166666,     0.666666, 0.166666, 0.0 /
  43.  
  44.     data power/
  45.      +        1.0, 0.0, 0.0, 0.0,
  46.      +        0.0, 1.0, 0.0, 0.0,
  47.      +        0.0, 0.0, 1.0, 0.0,
  48.      +        0.0, 0.0, 0.0, 1.0/
  49.  
  50.     data    x1 / 
  51.      +        0.0,   0.2588,   0.5,   0.7071,
  52.      +        0.0,   0.51764,  1.0,   1.4142,
  53.      +        0.0,   0.51764,  1.0,   1.4142,
  54.      +        0.0,   0.2588,   0.5,   0.7071/
  55.  
  56.     data    y1 / 
  57.      +        1.0,   0.966,   0.866,  0.7071,
  58.      +        2.0,   1.9318,  1.732,  1.4142,
  59.      +        2.0,   1.9318,  1.732,  1.4142,
  60.      +        1.0,   0.966,   0.866,  0.7071/
  61.  
  62.     data    z1 / 
  63.      +        1.0,   1.0,     1.0,    1.0,
  64.      +        1.0,   1.0,     1.0,    1.0,
  65.      +        0.0,   0.0,     0.0,    0.0,
  66.      +        0.0,   0.0,     0.0,    0.0/
  67.  
  68.     data    x2 / 
  69.      +        0.7071, 0.8660, 0.9660, 1.0,
  70.      +        1.4142, 1.7320, 1.932,  2.0,
  71.      +        1.4142, 1.7320, 1.932,  2.0,
  72.      +        0.7071, 0.8660, 0.9660, 1.0/
  73.  
  74.     data    y2 / 
  75.      +        0.7071, 0.5,    0.2588, 0.0,
  76.      +        1.4142, 1.0,    0.5176, 0.0,
  77.      +        1.4142, 1.0,    0.5176, 0.0,
  78.      +        0.7071, 0.5,    0.2588, 0.0/
  79.  
  80.     data    z2 / 
  81.      +        1.0,   1.0,     1.0,    1.0,
  82.      +        1.0,   1.0,     1.0,    1.0,
  83.      +        0.0,   0.0,     0.0,    0.0,
  84.      +        0.0,   0.0,     0.0,    0.0/
  85.  
  86.  
  87.     data labels /
  88.      +        'Bezier Patch(es)',
  89.      +        'Cardinal Patch(es)',
  90.      +        'B-Spline Patch(es)',
  91.      +        '''Power'' Patch(es)' /
  92.  
  93. c
  94. c  demonstrate patches
  95. c
  96.  
  97.     call winope('fpatches', 8)
  98.  
  99. c
  100. c We use the space bar to go to the next one...
  101. c
  102.     call unqdev(INPUTC)
  103.     call qdevic(SPACEK)
  104.  
  105. c
  106. c clear screen
  107. c
  108.     call color(BLACK)
  109.     call clear
  110. c
  111. c load a hershey font
  112. c
  113.     call hfont('times.r', 7)
  114.     call htexts(0.4, 0.4)
  115.  
  116. c
  117. c Set up two viewports (They actually overlap)
  118. c
  119.  
  120.     call getvie(vminx, vmaxx, vminy, vmaxy)
  121.  
  122.     minx = vminx
  123.     maxx = vmaxx
  124.     miny = vminy
  125.     maxy = vmaxy
  126.  
  127.     call viewpo(minx, (maxx - minx) / 10 * 6,
  128.      +              miny, (maxy - miny) / 10 * 6)
  129.  
  130.     call ortho(-2.0, 5.0, -2.0, 5.0, -2.0, 5.0)
  131.     call lookat(0.0, 0.0, 0.0, -3.0, 2.0, -4.0, 0.0)
  132. c
  133. c    Save it 
  134. c
  135.     call pushvi
  136.     call pushma
  137.  
  138.     call viewpo((maxx - minx) / 10 * 2, maxx,
  139.      +              (maxy - miny) / 10 * 2, maxy)
  140.  
  141.     call ortho(-2.0, 5.0, -2.0, 5.0, -2.0, 5.0)
  142.     call lookat(0.0, 0.0, 0.0, 3.0, 2.0, -4.0, 0.0)
  143.  
  144.  
  145. c
  146. c    patchcurves provides a number of curves in the t and u
  147. c    directions. patchprecision gives the minimum number of line
  148. c    segments making up the curves in the t and u directions. The
  149. c    actual number of linesegments in t or u is equal to the closest
  150. c    integer multiple of the number of curves, > nsegs, in t or u,
  151. c    greater than or equal to the number set by patchprecision in u or
  152. c    t. eg. curves in t will be made up of 21 line segments so that we
  153. c    can match up the 7 curves in u; curves in u will have 24 as 4 by 5
  154. c    gives 20.
  155. c
  156.     call patchc(4, 7)
  157.     call patchp(20, 20)
  158.  
  159.     do 10 i = 0, 3
  160.  
  161.         call axes
  162.  
  163.  
  164. c
  165. c         patchbasis sets the basis matrices for the t and u
  166. c         functions
  167. c 
  168. c
  169.         call defbas(i, basis(i*16 + 1))
  170.         call patchb(i, i)
  171.  
  172. c 
  173. c        Draw with viewport 2
  174. c
  175.         call move(0.0, 4.0, 0.0)
  176.         call hchars(labels(i + 1), nchars(labels(i + 1)))
  177.  
  178. c
  179. c        Now draw the patches according to the geometry matrices in
  180. c        x1, y1, and z1, x2, y2, z2.
  181. c
  182.         call drawhu(x1, y1, z1)
  183.         call patch(x1, y1, z1)
  184.  
  185.         call drawhu(x2, y2, z2)
  186.         call patch(x2, y2, z2)
  187. c
  188. c         Now with viewport 1
  189. c
  190.         call popvie
  191.         call popmat
  192.  
  193.         call axes
  194.  
  195.         call move(0.0, 4.0, 0.0)
  196.         call hchars(labels(i + 1), nchars(labels(i + 1)))
  197.  
  198. c
  199. c        now draw the patches according to the geometry matrices in
  200. c         x1, y1, and z1, x2, y2, z2.
  201. c
  202.         call drawhu(x1, y1, z1)
  203.         call patch(x1, y1, z1)
  204.  
  205.         call drawhu(x2, y2, z2)
  206.         call patch(x2, y2, z2)
  207.  
  208.         idum = qread(val)
  209. c
  210. c        Eat the up event as well...
  211. c
  212.         idum = qread(val)
  213. c
  214. c        Clear viewport 1.
  215. c
  216.         call color(BLACK)
  217.         call clear
  218. c
  219. c         Save viewport 1 again and reset to viewport 2
  220. c
  221.         call pushvi
  222.         call pushma
  223.  
  224.         call viewpo((maxx - minx) / 10 * 2, maxx,
  225.      +                      (maxy - miny) / 10 * 2, maxy)
  226.  
  227.         call ortho(-1.5, 5.0, -1.5, 5.0, -1.5, 5.0)
  228.         call lookat(0.0, 0.0, 0.0, 3.0, 2.0, -4.0, 0.0)
  229.  
  230.         call color(BLACK)
  231.         call clear
  232. 10    continue
  233.  
  234.     call gexit
  235.  
  236.     end
  237.  
  238.  
  239.     subroutine drawhu(x, y, z)
  240.     real    x(4,4), y(4,4), z(4,4)
  241.  
  242. $INCLUDE: 'fvogl.h'
  243.  
  244.     call color(MAGENT)    
  245.     do 10 i = 1,4
  246.         call move(x(i,1), y(i,1), z(i,1))
  247.         do 5 j = 1,4
  248.             call draw(x(i,j), y(i,j), z(i,j))
  249. 5        continue
  250. 10    continue
  251.     
  252.     do 20 i = 1,4
  253.         call move(x(1,i), y(1,i), z(1,i))
  254.         do 15 j = 1,4
  255.             call draw(x(j,i), y(j,i), z(j,i))
  256. 15        continue
  257. 20    continue
  258.  
  259.     call color(GREEN)
  260.     end
  261.  
  262. c
  263. c axes
  264. c
  265. c    draw the axes
  266. c
  267.  
  268.     subroutine axes
  269.  
  270.     integer YELLOW
  271.     parameter (YELLOW = 3)
  272.  
  273.     call color(YELLOW)
  274.     call move(0.0, 0.0, 0.0)
  275.     call draw(4.0, 0.0, 0.0)
  276.  
  277.     call move(0.0, 0.0, 0.0)
  278.     call draw(0.0, 4.0, 0.0)
  279.  
  280.     call move(0.0, 0.0, 0.0)
  281.     call draw(0.0, 0.0, 4.0)
  282.  
  283.     end
  284. c
  285. c nchars
  286. c
  287. c return the real length of a string padded with blanks
  288. c
  289.     integer function nchars(str)
  290.     character *(*) str
  291.  
  292.     do 10 i = len(str), 1, -1
  293.         if (str(i:i) .ne. ' ') then
  294.             nchars = i
  295.             return
  296.         end if
  297. 10      continue
  298.  
  299.     nchars = 0
  300.  
  301.     return
  302.  
  303.     end
  304.